$title	MPSGE Code Generator

set	labels /'$prod','$demand',o,i,t,n,m,x,q,p,d,e,r/,

	fcomp	Field components /
		label	Field label,
		nest	Nest identifier
		setid	Set identifier for nest(a TL field),

		arg	Argument identifier,
		fun	Function identifier,
		exc	Exception identifier /;

$include mgedata

set	sector(*)		Sector variable identifiers,
	commodity(*)		Commodity (price) variable identifiers,
	consumer(*)		Consumer (income) variable identifiers,
	auxiliary(*)		Auxiliary variables,
	function(*)		Function identifiers,
	setid(*)		Set identifiers,

	param(*)		Parameter identifiers,
	lineloc(*,line)		Location of variables,
	funrec(*,line)		Lines containing $prod or $demand function declaration,
	funblock(*,line)	Lines associated in a function block,
	input(line)		Input coefficient records for sector s,
	output(line)		Output coefficient records for sector s,
	demand(line)		Demand coefficient record
	endowment(line)		Endowment coefficient record

	nestid(line,field)	Nest identification fields,
	qfield(line,field)	Q fields,
	pfield(line,field)	P fields,
	afield(line,field)	A fields,
	tfield(line,field)	T fields,
	nfield(line,field)	N fields,
	mfield(line,field)	M fields,
	rfield(line,field)	R fields,

	s(*)			Dummy variable (sector);

alias (u,uu,*);
s(u) = no;

*	Identifier record and field types:

input(line)        = yes$fc(line,"f1","label","i");
output(line)       = yes$fc(line,"f1","label","o");
demand(line)        = yes$fc(line,"f1","label","d");
endowment(line)       = yes$fc(line,"f1","label","e");
qfield(line,field) = yes$fc(line,field,"label","q");
pfield(line,field) = yes$fc(line,field,"label","p");
afield(line,field) = yes$fc(line,field,"label","q");
tfield(line,field) = yes$fc(line,field,"label","t");
nfield(line,field) = yes$fc(line,field,"label","n");
mfield(line,field) = yes$fc(line,field,"label","m");
rfield(line,field) = yes$fc(line,field,"label","r");

loop(line,
    if ((fc(line,"f1","label","$prod") or fc(line,"f1","label","$demand")), 
      s(u) = fc(line,"f1","arg",u);
      sector(s)   = yes$fc(line,"f1","label","$prod");
      consumer(s) = yes$fc(line,"f1","label","$demand");
      funrec(s,line) = yes;
      funblock(s,line) = yes;
      nestid(line,field) = yes$(not sameas(field,"f1"));
    else
      funblock(s,line) = funblock(s,line-1);));

*	Loop through records to identify variable identifiers:

loop(fc(line,field,"label",u),
	loop(uu$fc(line,field,"arg",uu),
	  lineloc(uu,line) = yes;
	  consumer(uu)$sameas(u,"a") = yes;
	  param(uu)$(sameas(u,"t") or sameas(u,"q") or sameas(u,"p")) = yes;
	  auxiliary(uu)$(sameas(u,"n") or sameas(u,"r") or sameas(u,"x")) = yes;
	  commodity(uu)$(sameas(u,"o") or sameas(u,"i") or sameas(u,"d") or sameas(u,"e")) = yes;));

*	Go through field identifers to determine set identifiers, excluding identifiers which
*	appear as a nesting pointer:

loop(fd(line,field,fcomp,u)$(not nestid(line,field)), setid(u) = yes;);

*	Anything appearing as a .tl is a set identifier:

loop(fd(line,field,"setid",u)$nestid(line,field), setid(u) = yes;);

parameter	idbug(*)	Identifiers with inconsistent implied type;

idbug(u) = 1$sector(u) + 1$consumer(u) + 1$param(u) + 1$commodity(u) + 1$auxiliary(u) + 1$setid(u);
idbug(u)$idbug(u) = idbug(u)-1;
if (card(idbug),
	loop(u$(not idbug(u)),
	  sector(u) = no;
	  consumer(u) = no;
	  param(u) = no;
	  commodity(u) = no;
	  auxiliary(u) = no;
	  setid(u) = no;);
	  abort idbug, sector, consumer, param, commodity, auxiliary, setid;);

parameter	dimensions(*,line,field)	Implicit dimensionality;
loop(fc(line,field,fcomp,u)$(not nestid(line,field)), 
	dimensions(u,line,field) = sum(fd(line,field,fcomp,uu),1););
option dimensions:0:0:1;
display dimensions;

*	Generate domains:

set	fund(*,*)	Function domain
	recd(*,line,*)	Record domain
	cd(line,*)	Coefficient domain;

*	Function domain for each line in a production block:

alias (lline,line);
loop(funrec(s,line), fund(s,u) = fd(line,"f1","arg",u););
option fund:0:0:1;
display fund;

*	Record domain:

set	io /i,o/;
loop(funblock(s,line),
	loop(fc(line,"f1","label",io),
	  recd(s,line,u) = fd(line,"f1","arg",u);
	));
option recd:0:0:1;
display recd;

*	Coefficient domain:

loop(funblock(s,line),
	cd(line,u) = yes$(fund(s,u) or recd(s,line,u));
);

option cd:0:0:1;
display cd;

set	uncontrolled(line,field,fcomp,*)	Uncontrolled elements in field domains;

uncontrolled(fd(line,field,fcomp,u))$(not cd(line,u)) = yes;

*	Set identifiers (with .tl) suffix are possibly matched with 
*	the associated argument domain:

loop((line,field,u)$(fc(line,field,"setid",u) and fd(line,field,"arg",u)),
	uncontrolled(line,field,"setid",uu) = no;
	uncontrolled(line,field,"arg",u) = no;);
option uncontrolled:0:0:1;
abort$card(uncontrolled) uncontrolled;

*	Generate an echo-print:

file khdr /mpsge.hdr/; khdr.lw=0; put khdr;
file kgen /mpsge.gen/; kgen.lw=0; put kgen;

*	Generate one copy of the model using the descriptive
*	text for each label:

put '$ontext'/;

put '$model:%model%'/;
loop(s,
	loop(funblock(s,line),
	  loop(fc(line,field,fcomp,u),
	    if (sameas(fcomp,'label'), put fc.te(line,field,fcomp,u),' ';););
	  put /;));


*	Generate a second version in which we read element by element:

put ///'$model:%model%'/;
loop(s,
	loop(funblock(s,line),
	  loop(field,
	    loop(fc(line,field,fcomp,u),

*	Label fields:

	      if ((sameas(fcomp,'label') or sameas(fcomp,'nest')), 
	        put '{',field.tl,'}',u.tl,':';
		if (ft(line,field,"arg"), 
		  put ft.te(line,field,"arg");));

*	Set identifier fields:

              if (sameas(fcomp,'setid'),
	        put '{',field.tl,'}',u.tl,'.tl',':';
		if (ft(line,field,"arg"), 
		  put ft.te(line,field,"arg");));

*	Argument:

	      if (sameas(fcomp,'arg'),   
	        put u.tl;
		if (dimensions(u,line,field),
		  put '(',fc.te(line,field,fcomp,u),')';
		else
		  put ' ';)
		loop(uu$fc(line,field,"exc",uu),
		  put '$',uu.tl;
		  if (dimensions(uu,line,field),
		    put '(',fc.te(line,field,"exc",uu),')';)));
	      if (sameas(fcomp,'fun'),
	        put ' [',u.tl;
		if (dimensions(u,line,field),
		  put '(',fc.te(line,field,fcomp,u),')] ';
		else
		  put '] ';)));
	  put ' ';)
	  put /;));

put '$offtext'/;
